home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / qk3mdm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-13  |  11.8 KB  |  280 lines
  1. Unit Modempro ;
  2. (* ================================================================= *)
  3. (*  MODEM - Routines and Global variables for IBMPC compatiables.    *)
  4. (* ================================================================= *)
  5. Interface
  6.   Uses Dos,Crt,       (* Standard Turbo Pascal Units *)
  7.        KGlobals ;     (* Kermit Globals - Execution control Flags *)
  8.   Type
  9.       ParityType = (OddP,EvenP,MarkP,NoneP) ;
  10.   Const
  11.       DefaultBaud = 9600 ;
  12.   Var
  13.       PrimaryPort : Boolean ;
  14.       Baudrate    : Integer ;
  15.       Parity      : ParityType ;
  16.   Procedure Initmodem ;
  17.   Procedure ResetModem;
  18.   Procedure SetModem ;
  19.   Procedure AnswerModem ;
  20.   Procedure DialModem ;
  21.   Function RecvChar (var mchar : byte) : boolean ;
  22.   Function CharsInBuffer : integer ;
  23.   Procedure EmptyBuffer ;
  24.   Procedure SendChar (char : byte ) ;
  25.   Procedure SendBreak ;
  26.  
  27. (* ================================================================= *)
  28. Implementation
  29. CONST
  30.     (* Modem Registers *)
  31.     LowOrderDiv      = 0 ;
  32.     HiOrderDiv       = 1 ;  InterruptEnable = 1 ;
  33.     InterruptIdReg   = 2 ;
  34.     LineControlReg   = 3 ;
  35.     ModemControlReg  = 4 ;
  36.     LineStatusReg    = 5 ;
  37.     ModemStatusReg   = 6 ;
  38.     ClockRate        = 18430 ;  (* CentiHertz. - use 17895 for PCjr *)
  39.     (* 8259 Interrupt Controller addresses *)
  40.     (* IC8259Reg1 = $20 ;   IC8259Reg2 = $21 ; *)
  41.     MaxBuffsize = 32760 ;
  42.  
  43. VAR
  44.     Modem     : Integer ;
  45.     IntNumber,
  46.     EnableMask,ResetMask,SaveMask : byte ;
  47.     DSRcheck : boolean ;
  48.     OldVector  : pointer ;
  49.     Iout,Iin : integer ;
  50.     Buffer : Packed array [1..MaxBuffsize] of byte ;
  51.  
  52. (* ------------------------------------------------------------------ *)
  53. (* IntHandler - Interrupt handler                                     *)
  54. (*            This procedure handles the modem interrupts ,           *)
  55. (*            which occur for incomming data only.                    *)
  56. (* ------------------------------------------------------------------ *)
  57. Procedure IntHandler  ;
  58.     Interrupt ;
  59.     Begin (* IntHandler *)
  60.     Inline($FB) ;                       (* STI  set interrupt enable *)
  61.     While (Port[Modem+LineStatusReg] and $01) = $01 do
  62.          begin (* put char in buffer *)
  63.          buffer[Iin] := Port[Modem];
  64.          Iin := Iin + 1 ;
  65.          if Iin = MaxBuffsize then Iin := 1 ;
  66.          end ; (* put char in buffer *)
  67.     Port[$20] := ResetMask ;
  68.     End ;  (* IntHandler *)
  69.  
  70. (* ------------------------------------------------------------------ *)
  71. (* InitModem - Initialize the modem and setup interrupt procedure.    *)
  72. (* ------------------------------------------------------------------ *)
  73.     Procedure Initmodem ;
  74.     Var rate : integer ;
  75.     Begin (* Init modem *)
  76.     If PrimaryPort then
  77.          Begin (* Primary port *)
  78.          Modem := $3F8 ;
  79.          EnableMask := $EF ;
  80.          ResetMask := $64 ;    (* end of interrupt for IRQ4 *)
  81.          IntNumber := 12 ;
  82.          End  (* Primary Port *)
  83.                   else
  84.         Begin (* Secondary Port *)
  85.         Modem := $2F8 ;
  86.         EnableMask := $F7 ;
  87.         ResetMask := $63 ;   (* end of interrupt for IRQ3 *)
  88.         IntNumber := 11 ;
  89.         End ; (* Secondary Port *)
  90.     Iin := 1 ; Iout := 1 ;
  91.  
  92.     (* Initialize the Serial port Interrupt Procedure *)
  93.     GetIntVec(IntNumber,Oldvector) ;     (* save the Old interrupt handler *)
  94.     SetIntVec (IntNumber,@IntHandler) ;  (* Use our own interrupt handler *)
  95.     SaveMask  := Port[$21] ;             (* save setting *)
  96.     Port[$21] := Port[$21] and EnableMask ;  (* Enable serial port interrupt *)
  97.     Port[$20] := ResetMask ;
  98.  
  99.     (* Initialize baud rates and bits and parity *)
  100.     Rate := round( (Clockrate/16) / (Baudrate/100)) ;
  101.     Port[Modem+LineControlReg] := $80 ;     (* Enable baud rate setting *)
  102.     Port[Modem+LowOrderDiv]    := (rate and $00FF) ;
  103.     Port[Modem+HiOrderDiv]     := rate div $100 ;
  104.     Port[Modem+LineControlReg] := (ord(Parity) shl 4) OR $0A ;
  105.                                   (* parity, 7 bits,1 stop *)
  106.     Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS *)
  107.     Port[Modem+InterruptEnable] := $01 ;   (* Data Avail. Interrupt set *)
  108.     End ; (* Init modem *)
  109.  
  110. (* ------------------------------------------------------------------ *)
  111. (*  ResetModem - Reset the Interrupt back to the original.            *)
  112. (*       Global variables - Saveoffset,SaveSeq                        *)
  113. (* ------------------------------------------------------------------ *)
  114.     Procedure ResetModem;
  115.     Begin (* Reset Modem Interrupt *)
  116.     SetIntVec(IntNumber,Oldvector) ;   (* restore the Old interrupt handler *)
  117.     Port[$21] := SaveMask ;
  118.     Port[Modem+InterruptEnable] := $00 ;   (* Data Avail. Interrupt reset *)
  119.     End; (* Reset Modem Interrupt *)
  120.  
  121. (* ------------------------------------------------------------------ *)
  122. (*  SetModem -  Set the baud rate and parity for modem.               *)
  123. (*       Global variables - Modem,Clockrate,Baudrate,Parity           *)
  124. (* ------------------------------------------------------------------ *)
  125.     Procedure SetModem ;
  126.     Var rate : integer ;
  127.     Begin (* SetModem *)
  128.     If PrimaryPort then
  129.          Begin (* Primary port *)
  130.          Modem := $3F8 ;
  131.          EnableMask := $EF ;
  132.          ResetMask := $64 ;    (* end of interrupt for IRQ4 *)
  133.          End  (* Primary Port *)
  134.                   else
  135.         Begin (* Secondary Port *)
  136.         Modem := $2F8 ;
  137.         EnableMask := $F7 ;
  138.         ResetMask := $63 ;   (* end of interrupt for IRQ3 *)
  139.         End ; (* Secondary Port *)
  140.     Rate := round( (Clockrate/16) / (Baudrate/100)) ;
  141.     Port[Modem+LineControlReg] := $80 ;     (* Enable baud rate setting *)
  142.     Port[Modem+LowOrderDiv]    := (rate and $00FF) ;
  143.     Port[Modem+HiOrderDiv]     := rate div $100 ;
  144.     Port[Modem+LineControlReg] := (ord(Parity) shl 4) OR $0A ;
  145.                                   (* parity, 7 bits,1 stop *)
  146.     End ; (* SetModem *)
  147.  
  148. (* ------------------------------------------------------------------ *)
  149. (*  DialModem - Check and waits for modem to be connected.            *)
  150. (*              It waits for DSR  signals  be detected.               *)
  151. (*  Side Effect - global variable 'connected' is set true.            *)
  152. (* ------------------------------------------------------------------ *)
  153.    Procedure DialModem ;
  154.    var i : integer ;
  155.    Begin (* Dial Modem *)
  156.    While ((Port[Modem+ModemStatusReg] and $20) <> $20) and DSRcheck Do
  157.          Begin (* Connect modem please *)
  158.     (*   writeln('modem status =',Port[Modem+ModemStatusReg]); *)
  159.          writeln('  Please connect your modem ');
  160.          delay (1000);
  161.          If KeyPressed then  (* Bypass DSRcheck by hitting the space bar *)
  162.               DSRcheck := readkey <> ' ' ;
  163.          End ; (* Connect modem please *)
  164.    Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS  *)
  165.    connected := true ;
  166.    If audioflag then
  167.          for i:=1 to 50 do begin sound(100*i); delay(5); end ; nosound;
  168.    Writeln('  Connection completed ');
  169.    End ; (* Dial Modem *)
  170.  
  171. (* ------------------------------------------------------------------ *)
  172. (*  AnswerModem - Check and waits for modem to be connected.          *)
  173. (*              If DCD is off set RTS off.  Wait for DCD to get set   *)
  174. (*              then set RTS.   (  similar to DIALMODEM  )            *)
  175. (*  Side Effect - global variable 'connected' is set true.            *)
  176. (* ------------------------------------------------------------------ *)
  177.    Procedure AnswerModem ;
  178.    var count : integer ;
  179.    Begin (* Answer Modem *)
  180.    count := 0 ;
  181.    If (Port[Modem+ModemStatusReg] and $80) <> $80 then
  182.        Port[Modem+ModemControlReg] := $09 ;   (* set OUT2,DTR reset RTS  *)
  183.    clrscr ; GotoXY(10,10);
  184.    write(' Waiting for someone to connect  ');
  185.    While ((Port[Modem+ModemStatusReg] and $80) <> $80)  Do
  186.          Begin (* Connect modem please *)
  187.          Gotoxy( 44,10) ;  write(count);
  188.          delay (1000);  count := count + 1 ;
  189.          End ; (* Connect modem please *)
  190.    Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS  *)
  191.    Writeln('  Answer completed ');
  192.    End ; (* Answer Modem *)
  193.  
  194. (* ------------------------------------------------------------------ *)
  195. (* RecvChar - Receive a Character from the modem port.                *)
  196. (*            TRUE - if there is a character from the modem and       *)
  197. (*                   the character is returned in the parmeter.       *)
  198. (*            FALSE - if no character found .                         *)
  199. (*                                                                    *)
  200. (* ------------------------------------------------------------------ *)
  201.     Function RecvChar (var mchar : byte) : boolean ;
  202.     Begin (* RecvChar *)
  203.     if Iin <> Iout then
  204.          begin (* get char from buffer *)
  205.          If Parity = NoneP then mchar := buffer[Iout]
  206.                            else mchar := buffer[Iout] and $7F ;
  207.          Iout := Iout + 1 ;
  208.          If Iout = MaxBuffsize then Iout := 1 ;
  209.          RecvChar := true ;
  210.          if logging then
  211.                      Begin {$I-}
  212.                      write(Logfile,chr(mchar));
  213.                      If IOresult <> 0 then
  214.                         Begin (* IO error *)
  215.                         Writeln(' Disk is Full - logging teminated');
  216.                         logging := false  ;
  217.                         Close(Logfile);
  218.                         End ; (* IO error *)
  219.                      End ; {$I+}
  220.          end   (* get char from buffer *)
  221.                    else
  222.          RecvChar := false ;
  223.     End ; (* RecvChar *)
  224.  
  225. (* ------------------------------------------------------------------ *)
  226. (* SendChar - Send a character thru the modem port.                   *)
  227. (*           It waits for the previous character to be sent before    *)
  228. (*           sending the current character.                           *)
  229. (* ------------------------------------------------------------------ *)
  230.     Procedure SendChar(char : byte ) ;
  231.     Begin (* Send Char *)
  232.     While  (Port[Modem+LineStatusReg] and $20) <> $20 do delay(1);
  233.          Port[modem] := char ;
  234.     End ;  (* Send Char *)
  235.  
  236. (* ------------------------------------------------------------------ *)
  237. (* CharsInBuffer - Returns the number of unprocessed characters in    *)
  238. (*                 the Buffer.                                        *)
  239. (* ------------------------------------------------------------------ *)
  240.     Function CharsInBuffer : integer ;
  241.     Begin (* Chars In Buffer *)
  242.     If Iin >= Iout then CharsInBuffer := Iin - Iout
  243.                    else CharsInBuffer := MaxBuffSize - Iout + Iin ;
  244.     End ; (* Chars In Buffer *)
  245.  
  246. (* ------------------------------------------------------------------ *)
  247. (* EmptyBuffer - Mark the buffer as being empty.                      *)
  248. (* ------------------------------------------------------------------ *)
  249.     Procedure EmptyBuffer ;
  250.     Begin (* Empty Buffer *)
  251.     Iout := Iin ;
  252.     End ; (* Empty Buffer *)
  253.  
  254. (* ------------------------------------------------------------------ *)
  255. (* SendBreak- Send a break via the modem port .                       *)
  256. (* ------------------------------------------------------------------ *)
  257.     Procedure SendBreak ;
  258.     Var Tbyte,dummy : byte ;
  259.     Begin (* Send Break *)
  260.     Tbyte := Port[Modem+LineControlReg] ;  (* save setting *)
  261.     Port[Modem+InterruptEnable] := $00 ;   (* Data Avail. Interrupt reset *)
  262.     Port[Modem+LineControlReg] := $40 ;    (* break for 200 millsec *)
  263.     GoToXy(1,24); Write(' *** BREAK *** ',chr(07));
  264.     Delay(200) ;
  265.     Port[Modem+LineControlReg] := Tbyte ;    (* restore setting *)
  266.     Delay(100) ;
  267.     dummy := Port[Modem] ;                  (* clear out incoming char *)
  268.     Port[Modem+InterruptEnable] := $01 ;   (* Data Avail. Interrupt set *)
  269.     End ;  (* Send Break *)
  270.  
  271. (* ================================================================= *)
  272. (*    End of MODEM routines for IBMPC compatiables.                  *)
  273. (* ================================================================= *)
  274. Begin
  275. Baudrate    := DefaultBaud ;
  276. PrimaryPort := True ;
  277. Parity      := EvenP ;
  278. InitModem ;
  279. DSRcheck    := True ;
  280. End. (* Modempro *)